<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
  <title>dtgsen.f</title>
 <meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!-- 
body { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default   { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default a { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.string   { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.string a { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.comment   { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.comment a { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
 --></style>

 </head>
  <body>

<pre>
      SUBROUTINE <a name="DTGSEN.1"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a>( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
     $                   ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
     $                   PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Modified to call <a name="DLACN2.9"></a><a href="dlacn2.f.html#DLACN2.1">DLACN2</a> in place of <a name="DLACON.9"></a><a href="dlacon.f.html#DLACON.1">DLACON</a>, 5 Feb 03, SJH.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      LOGICAL            WANTQ, WANTZ
      INTEGER            IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
     $                   M, N
      DOUBLE PRECISION   PL, PR
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Array Arguments ..
</span>      LOGICAL            SELECT( * )
      INTEGER            IWORK( * )
      DOUBLE PRECISION   A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
     $                   B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
     $                   WORK( * ), Z( LDZ, * )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="DTGSEN.28"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a> reorders the generalized real Schur decomposition of a real
</span><span class="comment">*</span><span class="comment">  matrix pair (A, B) (in terms of an orthonormal equivalence trans-
</span><span class="comment">*</span><span class="comment">  formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
</span><span class="comment">*</span><span class="comment">  appears in the leading diagonal blocks of the upper quasi-triangular
</span><span class="comment">*</span><span class="comment">  matrix A and the upper triangular B. The leading columns of Q and
</span><span class="comment">*</span><span class="comment">  Z form orthonormal bases of the corresponding left and right eigen-
</span><span class="comment">*</span><span class="comment">  spaces (deflating subspaces). (A, B) must be in generalized real
</span><span class="comment">*</span><span class="comment">  Schur canonical form (as returned by <a name="DGGES.35"></a><a href="dgges.f.html#DGGES.1">DGGES</a>), i.e. A is block upper
</span><span class="comment">*</span><span class="comment">  triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
</span><span class="comment">*</span><span class="comment">  triangular.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="DTGSEN.39"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a> also computes the generalized eigenvalues
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  of the reordered matrix pair (A, B).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Optionally, <a name="DTGSEN.45"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a> computes the estimates of reciprocal condition
</span><span class="comment">*</span><span class="comment">  numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
</span><span class="comment">*</span><span class="comment">  (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
</span><span class="comment">*</span><span class="comment">  between the matrix pairs (A11, B11) and (A22,B22) that correspond to
</span><span class="comment">*</span><span class="comment">  the selected cluster and the eigenvalues outside the cluster, resp.,
</span><span class="comment">*</span><span class="comment">  and norms of &quot;projections&quot; onto left and right eigenspaces w.r.t.
</span><span class="comment">*</span><span class="comment">  the selected cluster in the (1,1)-block.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  IJOB    (input) INTEGER
</span><span class="comment">*</span><span class="comment">          Specifies whether condition numbers are required for the
</span><span class="comment">*</span><span class="comment">          cluster of eigenvalues (PL and PR) or the deflating subspaces
</span><span class="comment">*</span><span class="comment">          (Difu and Difl):
</span><span class="comment">*</span><span class="comment">           =0: Only reorder w.r.t. SELECT. No extras.
</span><span class="comment">*</span><span class="comment">           =1: Reciprocal of norms of &quot;projections&quot; onto left and right
</span><span class="comment">*</span><span class="comment">               eigenspaces w.r.t. the selected cluster (PL and PR).
</span><span class="comment">*</span><span class="comment">           =2: Upper bounds on Difu and Difl. F-norm-based estimate
</span><span class="comment">*</span><span class="comment">               (DIF(1:2)).
</span><span class="comment">*</span><span class="comment">           =3: Estimate of Difu and Difl. 1-norm-based estimate
</span><span class="comment">*</span><span class="comment">               (DIF(1:2)).
</span><span class="comment">*</span><span class="comment">               About 5 times as expensive as IJOB = 2.
</span><span class="comment">*</span><span class="comment">           =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
</span><span class="comment">*</span><span class="comment">               version to get it all.
</span><span class="comment">*</span><span class="comment">           =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  WANTQ   (input) LOGICAL
</span><span class="comment">*</span><span class="comment">          .TRUE. : update the left transformation matrix Q;
</span><span class="comment">*</span><span class="comment">          .FALSE.: do not update Q.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  WANTZ   (input) LOGICAL
</span><span class="comment">*</span><span class="comment">          .TRUE. : update the right transformation matrix Z;
</span><span class="comment">*</span><span class="comment">          .FALSE.: do not update Z.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  SELECT  (input) LOGICAL array, dimension (N)
</span><span class="comment">*</span><span class="comment">          SELECT specifies the eigenvalues in the selected cluster.
</span><span class="comment">*</span><span class="comment">          To select a real eigenvalue w(j), SELECT(j) must be set to
</span><span class="comment">*</span><span class="comment">          .TRUE.. To select a complex conjugate pair of eigenvalues
</span><span class="comment">*</span><span class="comment">          w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
</span><span class="comment">*</span><span class="comment">          either SELECT(j) or SELECT(j+1) or both must be set to
</span><span class="comment">*</span><span class="comment">          .TRUE.; a complex conjugate pair of eigenvalues must be
</span><span class="comment">*</span><span class="comment">          either both included in the cluster or both excluded.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  N       (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The order of the matrices A and B. N &gt;= 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  A       (input/output) DOUBLE PRECISION array, dimension(LDA,N)
</span><span class="comment">*</span><span class="comment">          On entry, the upper quasi-triangular matrix A, with (A, B) in
</span><span class="comment">*</span><span class="comment">          generalized real Schur canonical form.
</span><span class="comment">*</span><span class="comment">          On exit, A is overwritten by the reordered matrix A.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  LDA     (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The leading dimension of the array A. LDA &gt;= max(1,N).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  B       (input/output) DOUBLE PRECISION array, dimension(LDB,N)
</span><span class="comment">*</span><span class="comment">          On entry, the upper triangular matrix B, with (A, B) in
</span><span class="comment">*</span><span class="comment">          generalized real Schur canonical form.
</span><span class="comment">*</span><span class="comment">          On exit, B is overwritten by the reordered matrix B.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  LDB     (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The leading dimension of the array B. LDB &gt;= max(1,N).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ALPHAR  (output) DOUBLE PRECISION array, dimension (N)
</span><span class="comment">*</span><span class="comment">  ALPHAI  (output) DOUBLE PRECISION array, dimension (N)
</span><span class="comment">*</span><span class="comment">  BETA    (output) DOUBLE PRECISION array, dimension (N)
</span><span class="comment">*</span><span class="comment">          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
</span><span class="comment">*</span><span class="comment">          be the generalized eigenvalues.  ALPHAR(j) + ALPHAI(j)*i
</span><span class="comment">*</span><span class="comment">          and BETA(j),j=1,...,N  are the diagonals of the complex Schur
</span><span class="comment">*</span><span class="comment">          form (S,T) that would result if the 2-by-2 diagonal blocks of
</span><span class="comment">*</span><span class="comment">          the real generalized Schur form of (A,B) were further reduced
</span><span class="comment">*</span><span class="comment">          to triangular form using complex unitary transformations.
</span><span class="comment">*</span><span class="comment">          If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
</span><span class="comment">*</span><span class="comment">          positive, then the j-th and (j+1)-st eigenvalues are a
</span><span class="comment">*</span><span class="comment">          complex conjugate pair, with ALPHAI(j+1) negative.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Q       (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
</span><span class="comment">*</span><span class="comment">          On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
</span><span class="comment">*</span><span class="comment">          On exit, Q has been postmultiplied by the left orthogonal
</span><span class="comment">*</span><span class="comment">          transformation matrix which reorder (A, B); The leading M
</span><span class="comment">*</span><span class="comment">          columns of Q form orthonormal bases for the specified pair of
</span><span class="comment">*</span><span class="comment">          left eigenspaces (deflating subspaces).
</span><span class="comment">*</span><span class="comment">          If WANTQ = .FALSE., Q is not referenced.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  LDQ     (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The leading dimension of the array Q.  LDQ &gt;= 1;
</span><span class="comment">*</span><span class="comment">          and if WANTQ = .TRUE., LDQ &gt;= N.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
</span><span class="comment">*</span><span class="comment">          On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
</span><span class="comment">*</span><span class="comment">          On exit, Z has been postmultiplied by the left orthogonal
</span><span class="comment">*</span><span class="comment">          transformation matrix which reorder (A, B); The leading M
</span><span class="comment">*</span><span class="comment">          columns of Z form orthonormal bases for the specified pair of
</span><span class="comment">*</span><span class="comment">          left eigenspaces (deflating subspaces).
</span><span class="comment">*</span><span class="comment">          If WANTZ = .FALSE., Z is not referenced.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  LDZ     (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The leading dimension of the array Z. LDZ &gt;= 1;
</span><span class="comment">*</span><span class="comment">          If WANTZ = .TRUE., LDZ &gt;= N.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  M       (output) INTEGER
</span><span class="comment">*</span><span class="comment">          The dimension of the specified pair of left and right eigen-
</span><span class="comment">*</span><span class="comment">          spaces (deflating subspaces). 0 &lt;= M &lt;= N.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  PL      (output) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment">  PR      (output) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment">          If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
</span><span class="comment">*</span><span class="comment">          reciprocal of the norm of &quot;projections&quot; onto left and right
</span><span class="comment">*</span><span class="comment">          eigenspaces with respect to the selected cluster.
</span><span class="comment">*</span><span class="comment">          0 &lt; PL, PR &lt;= 1.
</span><span class="comment">*</span><span class="comment">          If M = 0 or M = N, PL = PR  = 1.
</span><span class="comment">*</span><span class="comment">          If IJOB = 0, 2 or 3, PL and PR are not referenced.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  DIF     (output) DOUBLE PRECISION array, dimension (2).
</span><span class="comment">*</span><span class="comment">          If IJOB &gt;= 2, DIF(1:2) store the estimates of Difu and Difl.
</span><span class="comment">*</span><span class="comment">          If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
</span><span class="comment">*</span><span class="comment">          Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
</span><span class="comment">*</span><span class="comment">          estimates of Difu and Difl.
</span><span class="comment">*</span><span class="comment">          If M = 0 or N, DIF(1:2) = F-norm([A, B]).
</span><span class="comment">*</span><span class="comment">          If IJOB = 0 or 1, DIF is not referenced.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
</span><span class="comment">*</span><span class="comment">          IF IJOB = 0, WORK is not referenced.  Otherwise,
</span><span class="comment">*</span><span class="comment">          on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  LWORK   (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The dimension of the array WORK. LWORK &gt;=  4*N+16.
</span><span class="comment">*</span><span class="comment">          If IJOB = 1, 2 or 4, LWORK &gt;= MAX(4*N+16, 2*M*(N-M)).
</span><span class="comment">*</span><span class="comment">          If IJOB = 3 or 5, LWORK &gt;= MAX(4*N+16, 4*M*(N-M)).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">          If LWORK = -1, then a workspace query is assumed; the routine
</span><span class="comment">*</span><span class="comment">          only calculates the optimal size of the WORK array, returns
</span><span class="comment">*</span><span class="comment">          this value as the first entry of the WORK array, and no error
</span><span class="comment">*</span><span class="comment">          message related to LWORK is issued by <a name="XERBLA.178"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  IWORK   (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
</span><span class="comment">*</span><span class="comment">          IF IJOB = 0, IWORK is not referenced.  Otherwise,
</span><span class="comment">*</span><span class="comment">          on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  LIWORK  (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The dimension of the array IWORK. LIWORK &gt;= 1.
</span><span class="comment">*</span><span class="comment">          If IJOB = 1, 2 or 4, LIWORK &gt;=  N+6.
</span><span class="comment">*</span><span class="comment">          If IJOB = 3 or 5, LIWORK &gt;= MAX(2*M*(N-M), N+6).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">          If LIWORK = -1, then a workspace query is assumed; the
</span><span class="comment">*</span><span class="comment">          routine only calculates the optimal size of the IWORK array,
</span><span class="comment">*</span><span class="comment">          returns this value as the first entry of the IWORK array, and
</span><span class="comment">*</span><span class="comment">          no error message related to LIWORK is issued by <a name="XERBLA.192"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  INFO    (output) INTEGER
</span><span class="comment">*</span><span class="comment">            =0: Successful exit.
</span><span class="comment">*</span><span class="comment">            &lt;0: If INFO = -i, the i-th argument had an illegal value.
</span><span class="comment">*</span><span class="comment">            =1: Reordering of (A, B) failed because the transformed
</span><span class="comment">*</span><span class="comment">                matrix pair (A, B) would be too far from generalized
</span><span class="comment">*</span><span class="comment">                Schur form; the problem is very ill-conditioned.
</span><span class="comment">*</span><span class="comment">                (A, B) may have been partially reordered.
</span><span class="comment">*</span><span class="comment">                If requested, 0 is returned in DIF(*), PL and PR.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Further Details
</span><span class="comment">*</span><span class="comment">  ===============
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="DTGSEN.206"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a> first collects the selected eigenvalues by computing
</span><span class="comment">*</span><span class="comment">  orthogonal U and W that move them to the top left corner of (A, B).
</span><span class="comment">*</span><span class="comment">  In other words, the selected eigenvalues are the eigenvalues of
</span><span class="comment">*</span><span class="comment">  (A11, B11) in:
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                U'*(A, B)*W = (A11 A12) (B11 B12) n1
</span><span class="comment">*</span><span class="comment">                              ( 0  A22),( 0  B22) n2
</span><span class="comment">*</span><span class="comment">                                n1  n2    n1  n2
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  where N = n1+n2 and U' means the transpose of U. The first n1 columns
</span><span class="comment">*</span><span class="comment">  of U and W span the specified pair of left and right eigenspaces
</span><span class="comment">*</span><span class="comment">  (deflating subspaces) of (A, B).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  If (A, B) has been obtained from the generalized real Schur
</span><span class="comment">*</span><span class="comment">  decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
</span><span class="comment">*</span><span class="comment">  reordered generalized real Schur form of (C, D) is given by
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  and the first n1 columns of Q*U and Z*W span the corresponding
</span><span class="comment">*</span><span class="comment">  deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Note that if the selected eigenvalue is sufficiently ill-conditioned,
</span><span class="comment">*</span><span class="comment">  then its value may differ significantly from its value before
</span><span class="comment">*</span><span class="comment">  reordering.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  The reciprocal condition numbers of the left and right eigenspaces
</span><span class="comment">*</span><span class="comment">  spanned by the first n1 columns of U and W (or Q*U and Z*W) may
</span><span class="comment">*</span><span class="comment">  be returned in DIF(1:2), corresponding to Difu and Difl, resp.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  The Difu and Difl are defined as:
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">       Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
</span><span class="comment">*</span><span class="comment">  and
</span><span class="comment">*</span><span class="comment">       Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  where sigma-min(Zu) is the smallest singular value of the
</span><span class="comment">*</span><span class="comment">  (2*n1*n2)-by-(2*n1*n2) matrix
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">       Zu = [ kron(In2, A11)  -kron(A22', In1) ]
</span><span class="comment">*</span><span class="comment">            [ kron(In2, B11)  -kron(B22', In1) ].
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Here, Inx is the identity matrix of size nx and A22' is the
</span><span class="comment">*</span><span class="comment">  transpose of A22. kron(X, Y) is the Kronecker product between
</span><span class="comment">*</span><span class="comment">  the matrices X and Y.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  When DIF(2) is small, small changes in (A, B) can cause large changes
</span><span class="comment">*</span><span class="comment">  in the deflating subspace. An approximate (asymptotic) bound on the
</span><span class="comment">*</span><span class="comment">  maximum angular error in the computed deflating subspaces is
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">       EPS * norm((A, B)) / DIF(2),
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  where EPS is the machine precision.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  The reciprocal norm of the projectors on the left and right
</span><span class="comment">*</span><span class="comment">  eigenspaces associated with (A11, B11) may be returned in PL and PR.
</span><span class="comment">*</span><span class="comment">  They are computed as follows. First we compute L and R so that
</span><span class="comment">*</span><span class="comment">  P*(A, B)*Q is block diagonal, where
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">       P = ( I -L ) n1           Q = ( I R ) n1
</span><span class="comment">*</span><span class="comment">           ( 0  I ) n2    and        ( 0 I ) n2
</span><span class="comment">*</span><span class="comment">             n1 n2                    n1 n2
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  and (L, R) is the solution to the generalized Sylvester equation
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">       A11*R - L*A22 = -A12
</span><span class="comment">*</span><span class="comment">       B11*R - L*B22 = -B12
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
</span><span class="comment">*</span><span class="comment">  An approximate (asymptotic) bound on the average absolute error of
</span><span class="comment">*</span><span class="comment">  the selected eigenvalues is
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">       EPS * norm((A, B)) / PL.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  There are also global error bounds which valid for perturbations up
</span><span class="comment">*</span><span class="comment">  to a certain restriction:  A lower bound (x) on the smallest
</span><span class="comment">*</span><span class="comment">  F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
</span><span class="comment">*</span><span class="comment">  coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
</span><span class="comment">*</span><span class="comment">  (i.e. (A + E, B + F), is
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">   x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  An approximate bound on x can be computed from DIF(1:2), PL and PR.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  If y = ( F-norm(E,F) / x) &lt;= 1, the angles between the perturbed
</span><span class="comment">*</span><span class="comment">  (L', R') and unperturbed (L, R) left and right deflating subspaces
</span><span class="comment">*</span><span class="comment">  associated with the selected cluster in the (1,1)-blocks can be
</span><span class="comment">*</span><span class="comment">  bounded as
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">   max-angle(L, L') &lt;= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
</span><span class="comment">*</span><span class="comment">   max-angle(R, R') &lt;= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  See LAPACK User's Guide section 4.11 or the following references
</span><span class="comment">*</span><span class="comment">  for more information.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Note that if the default method for computing the Frobenius-norm-
</span><span class="comment">*</span><span class="comment">  based estimate DIF is not wanted (see <a name="DLATDF.302"></a><a href="dlatdf.f.html#DLATDF.1">DLATDF</a>), then the parameter
</span><span class="comment">*</span><span class="comment">  IDIFJB (see below) should be changed from 3 to 4 (routine <a name="DLATDF.303"></a><a href="dlatdf.f.html#DLATDF.1">DLATDF</a>
</span><span class="comment">*</span><span class="comment">  (IJOB = 2 will be used)). See <a name="DTGSYL.304"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a> for more details.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Based on contributions by
</span><span class="comment">*</span><span class="comment">     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
</span><span class="comment">*</span><span class="comment">     Umea University, S-901 87 Umea, Sweden.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  References
</span><span class="comment">*</span><span class="comment">  ==========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
</span><span class="comment">*</span><span class="comment">      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
</span><span class="comment">*</span><span class="comment">      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
</span><span class="comment">*</span><span class="comment">      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
</span><span class="comment">*</span><span class="comment">      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
</span><span class="comment">*</span><span class="comment">      Estimation: Theory, Algorithms and Software,
</span><span class="comment">*</span><span class="comment">      Report UMINF - 94.04, Department of Computing Science, Umea
</span><span class="comment">*</span><span class="comment">      University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
</span><span class="comment">*</span><span class="comment">      Note 87. To appear in Numerical Algorithms, 1996.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
</span><span class="comment">*</span><span class="comment">      for Solving the Generalized Sylvester Equation and Estimating the
</span><span class="comment">*</span><span class="comment">      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
</span><span class="comment">*</span><span class="comment">      Department of Computing Science, Umea University, S-901 87 Umea,
</span><span class="comment">*</span><span class="comment">      Sweden, December 1993, Revised April 1994, Also as LAPACK Working
</span><span class="comment">*</span><span class="comment">      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
</span><span class="comment">*</span><span class="comment">      1996.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Parameters ..
</span>      INTEGER            IDIFJB
      PARAMETER          ( IDIFJB = 3 )
      DOUBLE PRECISION   ZERO, ONE
      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      LOGICAL            LQUERY, PAIR, SWAP, WANTD, WANTD1, WANTD2,
     $                   WANTP
      INTEGER            I, IERR, IJB, K, KASE, KK, KS, LIWMIN, LWMIN,
     $                   MN2, N1, N2
      DOUBLE PRECISION   DSCALE, DSUM, EPS, RDSCAL, SMLNUM
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Local Arrays ..
</span>      INTEGER            ISAVE( 3 )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Subroutines ..
</span>      EXTERNAL           <a name="DLACN2.352"></a><a href="dlacn2.f.html#DLACN2.1">DLACN2</a>, <a name="DLACPY.352"></a><a href="dlacpy.f.html#DLACPY.1">DLACPY</a>, <a name="DLAG2.352"></a><a href="dlag2.f.html#DLAG2.1">DLAG2</a>, <a name="DLASSQ.352"></a><a href="dlassq.f.html#DLASSQ.1">DLASSQ</a>, <a name="DTGEXC.352"></a><a href="dtgexc.f.html#DTGEXC.1">DTGEXC</a>, <a name="DTGSYL.352"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>,
     $                   <a name="XERBLA.353"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Functions ..
</span>      DOUBLE PRECISION   <a name="DLAMCH.356"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>
      EXTERNAL           <a name="DLAMCH.357"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Intrinsic Functions ..
</span>      INTRINSIC          MAX, SIGN, SQRT
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Decode and test the input parameters
</span><span class="comment">*</span><span class="comment">
</span>      INFO = 0
      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
<span class="comment">*</span><span class="comment">
</span>      IF( IJOB.LT.0 .OR. IJOB.GT.5 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -5
      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
         INFO = -7
      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
         INFO = -9
      ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
         INFO = -14
      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
         INFO = -16
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.384"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="DTGSEN.384"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a>'</span>, -INFO )
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Get machine constants
</span><span class="comment">*</span><span class="comment">
</span>      EPS = <a name="DLAMCH.390"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>( <span class="string">'P'</span> )
      SMLNUM = <a name="DLAMCH.391"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>( <span class="string">'S'</span> ) / EPS
      IERR = 0
<span class="comment">*</span><span class="comment">
</span>      WANTP = IJOB.EQ.1 .OR. IJOB.GE.4
      WANTD1 = IJOB.EQ.2 .OR. IJOB.EQ.4
      WANTD2 = IJOB.EQ.3 .OR. IJOB.EQ.5
      WANTD = WANTD1 .OR. WANTD2
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Set M to the dimension of the specified pair of deflating
</span><span class="comment">*</span><span class="comment">     subspaces.
</span><span class="comment">*</span><span class="comment">
</span>      M = 0
      PAIR = .FALSE.
      DO 10 K = 1, N
         IF( PAIR ) THEN
            PAIR = .FALSE.
         ELSE
            IF( K.LT.N ) THEN
               IF( A( K+1, K ).EQ.ZERO ) THEN
                  IF( SELECT( K ) )
     $               M = M + 1
               ELSE
                  PAIR = .TRUE.
                  IF( SELECT( K ) .OR. SELECT( K+1 ) )
     $               M = M + 2
               END IF
            ELSE
               IF( SELECT( N ) )
     $            M = M + 1
            END IF
         END IF
   10 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
         LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) )
         LIWMIN = MAX( 1, N+6 )
      ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN
         LWMIN = MAX( 1, 4*N+16, 4*M*( N-M ) )
         LIWMIN = MAX( 1, 2*M*( N-M ), N+6 )
      ELSE
         LWMIN = MAX( 1, 4*N+16 )
         LIWMIN = 1
      END IF
<span class="comment">*</span><span class="comment">
</span>      WORK( 1 ) = LWMIN
      IWORK( 1 ) = LIWMIN
<span class="comment">*</span><span class="comment">
</span>      IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
         INFO = -22
      ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
         INFO = -24
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.445"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="DTGSEN.445"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a>'</span>, -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Quick return if possible.
</span><span class="comment">*</span><span class="comment">
</span>      IF( M.EQ.N .OR. M.EQ.0 ) THEN
         IF( WANTP ) THEN
            PL = ONE
            PR = ONE
         END IF
         IF( WANTD ) THEN
            DSCALE = ZERO
            DSUM = ONE
            DO 20 I = 1, N
               CALL <a name="DLASSQ.462"></a><a href="dlassq.f.html#DLASSQ.1">DLASSQ</a>( N, A( 1, I ), 1, DSCALE, DSUM )
               CALL <a name="DLASSQ.463"></a><a href="dlassq.f.html#DLASSQ.1">DLASSQ</a>( N, B( 1, I ), 1, DSCALE, DSUM )
   20       CONTINUE
            DIF( 1 ) = DSCALE*SQRT( DSUM )
            DIF( 2 ) = DIF( 1 )
         END IF
         GO TO 60
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Collect the selected blocks at the top-left corner of (A, B).
</span><span class="comment">*</span><span class="comment">
</span>      KS = 0
      PAIR = .FALSE.
      DO 30 K = 1, N
         IF( PAIR ) THEN
            PAIR = .FALSE.
         ELSE
<span class="comment">*</span><span class="comment">
</span>            SWAP = SELECT( K )
            IF( K.LT.N ) THEN
               IF( A( K+1, K ).NE.ZERO ) THEN
                  PAIR = .TRUE.
                  SWAP = SWAP .OR. SELECT( K+1 )
               END IF
            END IF
<span class="comment">*</span><span class="comment">
</span>            IF( SWAP ) THEN
               KS = KS + 1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Swap the K-th block to position KS.
</span><span class="comment">*</span><span class="comment">              Perform the reordering of diagonal blocks in (A, B)
</span><span class="comment">*</span><span class="comment">              by orthogonal transformation matrices and update
</span><span class="comment">*</span><span class="comment">              Q and Z accordingly (if requested):
</span><span class="comment">*</span><span class="comment">
</span>               KK = K
               IF( K.NE.KS )
     $            CALL <a name="DTGEXC.498"></a><a href="dtgexc.f.html#DTGEXC.1">DTGEXC</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
     $                         Z, LDZ, KK, KS, WORK, LWORK, IERR )
<span class="comment">*</span><span class="comment">
</span>               IF( IERR.GT.0 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Swap is rejected: exit.
</span><span class="comment">*</span><span class="comment">
</span>                  INFO = 1
                  IF( WANTP ) THEN
                     PL = ZERO
                     PR = ZERO
                  END IF
                  IF( WANTD ) THEN
                     DIF( 1 ) = ZERO
                     DIF( 2 ) = ZERO
                  END IF
                  GO TO 60
               END IF
<span class="comment">*</span><span class="comment">
</span>               IF( PAIR )
     $            KS = KS + 1
            END IF
         END IF
   30 CONTINUE
      IF( WANTP ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Solve generalized Sylvester equation for R and L
</span><span class="comment">*</span><span class="comment">        and compute PL and PR.
</span><span class="comment">*</span><span class="comment">
</span>         N1 = M
         N2 = N - M
         I = N1 + 1
         IJB = 0
         CALL <a name="DLACPY.531"></a><a href="dlacpy.f.html#DLACPY.1">DLACPY</a>( <span class="string">'Full'</span>, N1, N2, A( 1, I ), LDA, WORK, N1 )
         CALL <a name="DLACPY.532"></a><a href="dlacpy.f.html#DLACPY.1">DLACPY</a>( <span class="string">'Full'</span>, N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ),
     $                N1 )
         CALL <a name="DTGSYL.534"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>( <span class="string">'N'</span>, IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
     $                N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1,
     $                DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
     $                LWORK-2*N1*N2, IWORK, IERR )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Estimate the reciprocal of norms of &quot;projections&quot; onto left
</span><span class="comment">*</span><span class="comment">        and right eigenspaces.
</span><span class="comment">*</span><span class="comment">
</span>         RDSCAL = ZERO
         DSUM = ONE
         CALL <a name="DLASSQ.544"></a><a href="dlassq.f.html#DLASSQ.1">DLASSQ</a>( N1*N2, WORK, 1, RDSCAL, DSUM )
         PL = RDSCAL*SQRT( DSUM )
         IF( PL.EQ.ZERO ) THEN
            PL = ONE
         ELSE
            PL = DSCALE / ( SQRT( DSCALE*DSCALE / PL+PL )*SQRT( PL ) )
         END IF
         RDSCAL = ZERO
         DSUM = ONE
         CALL <a name="DLASSQ.553"></a><a href="dlassq.f.html#DLASSQ.1">DLASSQ</a>( N1*N2, WORK( N1*N2+1 ), 1, RDSCAL, DSUM )
         PR = RDSCAL*SQRT( DSUM )
         IF( PR.EQ.ZERO ) THEN
            PR = ONE
         ELSE
            PR = DSCALE / ( SQRT( DSCALE*DSCALE / PR+PR )*SQRT( PR ) )
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( WANTD ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Compute estimates of Difu and Difl.
</span><span class="comment">*</span><span class="comment">
</span>         IF( WANTD1 ) THEN
            N1 = M
            N2 = N - M
            I = N1 + 1
            IJB = IDIFJB
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Frobenius norm-based Difu-estimate.
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="DTGSYL.574"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>( <span class="string">'N'</span>, IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
     $                   N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ),
     $                   N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ),
     $                   LWORK-2*N1*N2, IWORK, IERR )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Frobenius norm-based Difl-estimate.
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="DTGSYL.581"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>( <span class="string">'N'</span>, IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK,
     $                   N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ),
     $                   N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ),
     $                   LWORK-2*N1*N2, IWORK, IERR )
         ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Compute 1-norm-based estimates of Difu and Difl using
</span><span class="comment">*</span><span class="comment">           reversed communication with <a name="DLACN2.589"></a><a href="dlacn2.f.html#DLACN2.1">DLACN2</a>. In each step a
</span><span class="comment">*</span><span class="comment">           generalized Sylvester equation or a transposed variant
</span><span class="comment">*</span><span class="comment">           is solved.
</span><span class="comment">*</span><span class="comment">
</span>            KASE = 0
            N1 = M
            N2 = N - M
            I = N1 + 1
            IJB = 0
            MN2 = 2*N1*N2
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           1-norm-based estimate of Difu.
</span><span class="comment">*</span><span class="comment">
</span>   40       CONTINUE
            CALL <a name="DLACN2.603"></a><a href="dlacn2.f.html#DLACN2.1">DLACN2</a>( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 1 ),
     $                   KASE, ISAVE )
            IF( KASE.NE.0 ) THEN
               IF( KASE.EQ.1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Solve generalized Sylvester equation.
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="DTGSYL.610"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>( <span class="string">'N'</span>, IJB, N1, N2, A, LDA, A( I, I ), LDA,
     $                         WORK, N1, B, LDB, B( I, I ), LDB,
     $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
     $                         IERR )
               ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Solve the transposed variant.
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="DTGSYL.619"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>( <span class="string">'T'</span>, IJB, N1, N2, A, LDA, A( I, I ), LDA,
     $                         WORK, N1, B, LDB, B( I, I ), LDB,
     $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
     $                         IERR )
               END IF
               GO TO 40
            END IF
            DIF( 1 ) = DSCALE / DIF( 1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           1-norm-based estimate of Difl.
</span><span class="comment">*</span><span class="comment">
</span>   50       CONTINUE
            CALL <a name="DLACN2.632"></a><a href="dlacn2.f.html#DLACN2.1">DLACN2</a>( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 2 ),
     $                   KASE, ISAVE )
            IF( KASE.NE.0 ) THEN
               IF( KASE.EQ.1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Solve generalized Sylvester equation.
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="DTGSYL.639"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>( <span class="string">'N'</span>, IJB, N2, N1, A( I, I ), LDA, A, LDA,
     $                         WORK, N2, B( I, I ), LDB, B, LDB,
     $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
     $                         IERR )
               ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Solve the transposed variant.
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="DTGSYL.648"></a><a href="dtgsyl.f.html#DTGSYL.1">DTGSYL</a>( <span class="string">'T'</span>, IJB, N2, N1, A( I, I ), LDA, A, LDA,
     $                         WORK, N2, B( I, I ), LDB, B, LDB,
     $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
     $                         IERR )
               END IF
               GO TO 50
            END IF
            DIF( 2 ) = DSCALE / DIF( 2 )
<span class="comment">*</span><span class="comment">
</span>         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>   60 CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Compute generalized eigenvalues of reordered pair (A, B) and
</span><span class="comment">*</span><span class="comment">     normalize the generalized Schur form.
</span><span class="comment">*</span><span class="comment">
</span>      PAIR = .FALSE.
      DO 80 K = 1, N
         IF( PAIR ) THEN
            PAIR = .FALSE.
         ELSE
<span class="comment">*</span><span class="comment">
</span>            IF( K.LT.N ) THEN
               IF( A( K+1, K ).NE.ZERO ) THEN
                  PAIR = .TRUE.
               END IF
            END IF
<span class="comment">*</span><span class="comment">
</span>            IF( PAIR ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">             Compute the eigenvalue(s) at position K.
</span><span class="comment">*</span><span class="comment">
</span>               WORK( 1 ) = A( K, K )
               WORK( 2 ) = A( K+1, K )
               WORK( 3 ) = A( K, K+1 )
               WORK( 4 ) = A( K+1, K+1 )
               WORK( 5 ) = B( K, K )
               WORK( 6 ) = B( K+1, K )
               WORK( 7 ) = B( K, K+1 )
               WORK( 8 ) = B( K+1, K+1 )
               CALL <a name="DLAG2.690"></a><a href="dlag2.f.html#DLAG2.1">DLAG2</a>( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ),
     $                     BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ),
     $                     ALPHAI( K ) )
               ALPHAI( K+1 ) = -ALPHAI( K )
<span class="comment">*</span><span class="comment">
</span>            ELSE
<span class="comment">*</span><span class="comment">
</span>               IF( SIGN( ONE, B( K, K ) ).LT.ZERO ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 If B(K,K) is negative, make it positive
</span><span class="comment">*</span><span class="comment">
</span>                  DO 70 I = 1, N
                     A( K, I ) = -A( K, I )
                     B( K, I ) = -B( K, I )
                     Q( I, K ) = -Q( I, K )
   70             CONTINUE
               END IF
<span class="comment">*</span><span class="comment">
</span>               ALPHAR( K ) = A( K, K )
               ALPHAI( K ) = ZERO
               BETA( K ) = B( K, K )
<span class="comment">*</span><span class="comment">
</span>            END IF
         END IF
   80 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      WORK( 1 ) = LWMIN
      IWORK( 1 ) = LIWMIN
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="DTGSEN.721"></a><a href="dtgsen.f.html#DTGSEN.1">DTGSEN</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
